Mac-Source 1994 July/Mac-Source_July_1994.iso/C and C++/Compilers⁄Interps/kevoSource/memory.c

Text File | 1993-05-11 | 6KB | 230 lines

/* Kevo -- a prototype-based object-oriented language */
/* (c) Antero Taivalsaari 1991-1993                   */
/* Some parts (c) Antero Taivalsaari 1986-1988           */
/* memory.c: memory and object allocation internals   */

#include "global.h"

/*--------------------------------------------------------------------------*/
/* Memory allocation internals */

char* mymalloc(size)
int size;
{
  char* addr;

  if (!(addr = (char*)malloc(size))) {
    SysBeep(1); SysBeep(1);
    fprintf(confile, "== Not enough memory (malloc request: %ld bytes) ==\n", size);
    if (!supervisor) {
        ownPrintf("-- Not enough memory");
        execute((*up)->errorVector);
    }
    ownLongJmp();
  }
  return addr;
}


char* mycalloc(nelem, elsize)
int nelem;
int elsize;
{
  char* addr;

  if (!(addr = (char*)calloc(nelem, elsize))) {
    SysBeep(1); SysBeep(1);
    fprintf(confile, "== Not enough memory (calloc request: %ld bytes) ==\n", nelem*elsize);
    if (!supervisor) {
        ownPrintf("-- Not enough memory");
        execute((*up)->errorVector);
    }
    ownLongJmp();
  }
  return addr;
}


char* myrealloc(ptr, newsize)
char* ptr;
int   newsize;
{
  char* addr;

  if (!(addr = (char*)realloc(ptr, newsize))) {
    SysBeep(1); SysBeep(1);
    fprintf(confile, "== Not enough memory (realloc request: %ld bytes) ==\n", newsize);
    if (!supervisor) {
        ownPrintf("-- Not enough memory");
        execute((*up)->errorVector);
    }
    ownLongJmp();
  }
  return addr;
}


char* allocStrCpy(source)
char* source;
{
  char* target;

  target = (char*)mymalloc(strlen(source)+1);
  return(strcpy(target, source));
}


/*--------------------------------------------------------------------------*/
/* Object-specific operations */
/*
    These operations create, manipulate, and delete "non-object-oriented"
    objects (handle-store structures).

    For further info, see 'memory.h'.
*/

/* createStore(): create an initialized store part for an object */
/* Size is given in CELLS */

/* inlined for speed (see the header file 'memory.h')
STORE* createStore(size)
int size;
{
  return((STORE*)mycalloc(1, size*CELL));
}
*/


/* createPrimitive(): create a primitive object */
/*
    Primitives refer to the C operation directly via their 'mfa'
    field. Unlike other objects, primitives do not have a separate
    store part. The size field 'sfa' is always zero.
*/

OBJECT* createPrimitive(code)
int* code;
{
  OBJECT* newObject = (OBJECT*)mymalloc(sizeof(OBJECT));

      newObject->mfa = (STORE*)code;    /* Address of the C function */
      newObject->sfa = 0;    /* The size field of a primitive is zero */

      return(newObject);
}


/* createClosure(): create a closure object */

OBJECT* createClosure(size)
int size;    /* how much space do we need (in CELLS) */
{
  /* Allocate object */
  OBJECT* newObject = (OBJECT*)mymalloc(sizeof(OBJECT));
  STORE*  newStore;

  /* Ensure that size is at least 1 */
  size = (size > 1) ? size : 1;

  /* Store 'exit' to the beginning of the newly allocated memory */
  newStore = createStore(size);
  newStore->efa = (int*)oExit;

  /* Set the fields needed for closure objects */
  newObject->mfa = newStore;     /* Storage part for storing code */
  newObject->sfa = size;        /* Size of storage part in cells */

  return(newObject);
}


/* copyObject(): shallow copy an existing object and its store part */
/* this operation is needed for multitasking and prototype-based OOP */

OBJECT* copyObject(oldObject)
OBJECT* oldObject;
{
  int size = oldObject->sfa;
  OBJECT* newObject = (OBJECT*)mymalloc(sizeof(OBJECT));

    if (size) { /* Object is not a primitive */
      STORE*  newStore = createStore(size);
      int* newp = (int*)newStore;
      int* oldp = (int*)oldObject->mfa;
      int i;

        /* Copy old data to the new store part (shallow copy) */
        for (i = 0; i < size; i++) *newp++ = *oldp++;

        /* Set the fields needed for the new object */
        newObject->mfa = newStore;     /* Duplicated storage part */
        newObject->sfa = size;        /* Size of storage part in cells */
    }
    else {    /* Object is a primitive */
        newObject->mfa = oldObject->mfa; /* Share the same C operation */
        /* newObject->sfa = 0;    */        /* Size is automatically zero (=primitive) */
    }

    return(newObject);
}


/* deleteObject(): delete an existing object and its store part */

void deleteObject(object)
OBJECT* object;
{
    /* if the object has a store part (= is not a primitive), free the store */
    if (object->sfa) free((STORE*)object->mfa);
    free(object);
}


/* resizeClosure(): resize the storage area of an existing object */

void resizeClosure(object, newsize)
OBJECT* object;
int newsize;    /* The new size of the storage area (in cells) */
{
  int oldsize = object->sfa;

  /* If the new size is the same as the old size -> do nothing */

  /* Primitives (objects with size 0) cannot be resized at all */
  /* (since they do not have a store part) */

  /* Since the zero size implies that an object is a primitive */
  /* we do not allow size to be changed to zero */

  if (newsize == oldsize || oldsize == 0 || newsize < 1) return;

  object->mfa = (STORE*)myrealloc(object->mfa, newsize*CELL);
  object->sfa = newsize;

  /* Clear the possible newly allocated extra memory to zeros */
  while (oldsize < newsize) {
    int* ptr = (int*)object->mfa + oldsize++;
    *ptr = 0;
  }
}


/* Recognize an OOP object */

int recognizeObject(object)
OBJECT* object;
{
  OBJECT* code;

    if (!object) return UNKNOWN;
    if (!object->mfa) return UNKNOWN;
    if (object->sfa == 0) return PRIMITIVE;

    code = (OBJECT*)object->mfa->efa;
    if (code == oREF) return REF;
    if (code == oVAR) return VAR;
    if (code == oSharedConst) return CONST;
    return METHOD;
}